Import Billiken Sheets

Load libraries

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.2     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.2     ✔ tidyr     1.3.0
✔ purrr     1.0.1     ── Conflicts ────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors

library(googlesheets4)
library(fuzzyjoin)

Import google sheets of Billiken League data

Load FanGraphs Depth Charts Projections files

hitter_projections <- read_csv("hitter_projections_2025.csv") %>% 
  mutate(Name = stringi::stri_trans_general(Name, "Latin-ASCII"))

Rows: 618 Columns: 74── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (4): Name, Team, NameASCII, PlayerId
dbl (45): G, PA, AB, H, 1B, 2B, 3B, HR, R, RBI, BB, IBB, SO, HBP, SF, SH, SB, CS, AVG, BB%, K%, BB/K, OBP, SLG, wOBA, OP...
lgl (25): GDP, InterSD, InterSK, IntraSD, Vol, Skew, Dim, P10, P20, P30, P40, P50, P60, P70, P80, P90, TT10, TT20, TT30,...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

pitcher_projections <- read_csv("pitcher_projections_2025.csv") %>% 
  mutate(Name = stringi::stri_trans_general(Name, "Latin-ASCII"))

Rows: 837 Columns: 69── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (4): Name, Team, NameASCII, PlayerId
dbl (37): W, L, QS, ERA, G, GS, SV, HLD, IP, TBF, H, R, ER, HR, BB, HBP, SO, K/9, BB/9, K/BB, HR/9, K%, BB%, K-BB%, AVG,...
lgl (28): BS, IBB, GB%, HR/FB, InterSD, InterSK, IntraSD, Vol, Skew, Dim, P10, P20, P30, P40, P50, P60, P70, P80, P90, T...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

hitter_projections

pitcher_projections

NA

Filter out non-player rows

prefreeze_rosters <- prefreeze_rosters %>% 
  filter(!is.na(player)) %>% 
  mutate(across(c("salary"), ~gsub("\\$", "", .) %>% as.numeric))

Warning: There was 1 warning in `mutate()`.
ℹ In argument: `across(c("salary"), ~gsub("\\$", "", .) %>% as.numeric)`.
Caused by warning in `gsub("\\$", "", salary) %>% as.numeric`:
! NAs introduced by coercion

prefreeze_rosters

  #filter(billikenTeam == "Blue Socks")

Merge projections with pre-freeze rosters

hitter_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  #left_join(prefreeze_rosters, join_by('Name'=='player')) 
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2)

pitcher_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  #left_join(prefreeze_rosters, join_by('Name'=='player')) 
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2)

NA

Team Totals

(hitter_team_totals <- hitter_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  group_by(billikenTeam) %>% 
  summarize(n=n(), PA = sum(PA), AB = sum(AB), H = sum(H), HR = sum(HR), R = sum(R), RBI = sum(RBI), SB = sum(SB), AVG = sum(H)/sum(AB)))

(pitcher_team_totals <- pitcher_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  group_by(billikenTeam) %>% 
  summarize(n=n(), W = sum(W), SV = sum(SV), IP = sum(IP), SO = sum(SO), ER = sum(ER), H = sum(H), BB = sum(BB), ERA = sum(ER)*9/sum(IP), WHIP = (sum(H)+sum(BB))/sum(IP)) )

NA
NA

Team Standings

#Rank Team Totals
n_teams <- pull(count(hitter_team_totals %>% filter(!is.na(billikenTeam)) %>% distinct(billikenTeam)))

hitter_points <- hitter_team_totals %>% 
  filter(!is.na(billikenTeam)) %>% 
  mutate(hr = n_teams+1 - dense_rank(desc(HR)), r = n_teams+1 - dense_rank(desc(R)), rbi = n_teams+1 - dense_rank(desc(RBI)), sb = n_teams+1 - dense_rank(desc(SB)), avg = n_teams+1 - dense_rank(desc(AVG))) %>% 
  mutate(hr_pct = (hr-1)/(n_teams-1), r_pct = (r-1)/(n_teams-1), rbi_pct = (rbi-1)/(n_teams-1), sb_pct = (sb-1)/(n_teams-1), avg_pct = (avg-1)/(n_teams-1)) %>% 
  mutate(hit = hr + r + rbi + sb + avg) %>% 
  arrange(desc(hit))

hitter_points

pitcher_points <- pitcher_team_totals %>% 
  filter(!is.na(billikenTeam)) %>% 
  mutate(w = n_teams+1 - dense_rank(desc(W)), sv = n_teams+1 - dense_rank(desc(SV)), so = n_teams+1 - dense_rank(desc(SO)), era = n_teams+1 - dense_rank(ERA), whip = n_teams+1 - dense_rank(WHIP)) %>%
  mutate(w_pct = (w-1)/(n_teams-1), sv_pct = (sv-1)/(n_teams-1), so_pct = (so-1)/(n_teams-1), era_pct = (era-1)/(n_teams-1), whip_pct = (whip-1)/(n_teams-1)) %>%
  mutate(pit = w + sv + so + era + whip) %>% 
  arrange(desc(pit))

pitcher_points

NA

Project category variability

ggplot(hitter_points, aes(HR, hr_pct)) +
  geom_point() +
  stat_smooth(method="glm", method.args = list(family=binomial))

ggplot(pitcher_points, aes(ERA, era_pct)) +
  geom_point() +
  stat_smooth(method="glm", method.args = list(family=binomial))

Fit logistic regression curves

hr_model_glm <- glm(hr_pct ~ HR, data = hitter_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

hitter_points$hr_pts_pred = predict(hr_model_glm, hitter_points, type="response")*8+1

r_model_glm <- glm(r_pct ~ R, data = hitter_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

hitter_points$r_pts_pred = predict(r_model_glm, hitter_points, type="response")*8+1

rbi_model_glm <- glm(rbi_pct ~ RBI, data = hitter_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

hitter_points$rbi_pts_pred = predict(rbi_model_glm, hitter_points, type="response")*8+1

sb_model_glm <- glm(sb_pct ~ SB, data = hitter_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

hitter_points$sb_pts_pred = predict(sb_model_glm, hitter_points, type="response")*8+1

avg_model_glm <- glm(avg_pct ~ AVG, data = hitter_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

hitter_points$avg_pts_pred = predict(hr_model_glm, hitter_points, type="response")*8+1

(hitter_points <- hitter_points %>% 
  mutate(hitter_points_pred = hr_pts_pred + r_pts_pred + rbi_pts_pred + sb_pts_pred + avg_pts_pred) %>% 
    arrange(desc(hit)))

#instead of running this on teams, run this for every potential drafted player to project points impact of each player based on the current composition of each roster

w_model_glm <- glm(w_pct ~ W, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$w_pts_pred = predict(w_model_glm, pitcher_points, type="response")*8+1

sv_model_glm <- glm(sv_pct ~ SV, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$sv_pts_pred = predict(sv_model_glm, pitcher_points, type="response")*8+1

so_model_glm <- glm(so_pct ~ SO, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$so_pts_pred = predict(so_model_glm, pitcher_points, type="response")*8+1

era_model_glm <- glm(era_pct ~ ERA, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$era_pts_pred = predict(era_model_glm, pitcher_points, type="response")*8+1

whip_model_glm <- glm(whip_pct ~ WHIP, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$whip_pts_pred = predict(whip_model_glm, pitcher_points, type="response")*8+1

(pitcher_points <- pitcher_points %>% 
  mutate(pitcher_points_pred = w_pts_pred + sv_pts_pred + so_pts_pred + era_pts_pred + whip_pts_pred) %>% 
    arrange(desc(pitcher_points_pred)))

NA

hitter_points %>% 
  inner_join(pitcher_points, by = join_by(billikenTeam)) %>% 
  mutate(total = round(hitter_points_pred + pitcher_points_pred,1)) %>% 
  #mutate(total = hit + pit) %>% 
  select(billikenTeam, total, hr, r, rbi, sb, avg, w, sv, so, era, whip, total) %>% 
  arrange(desc(total)) 

Player projected point impact (average, not situation-based)

Simple linear model by category

hr_model <- lm(hr ~ HR, hitter_points) 
r_model <- lm(r ~ R, hitter_points) 
rbi_model <- lm(rbi ~ RBI, hitter_points) 
sb_model <- lm(sb ~ SB, hitter_points) 
avg_model <- lm(avg ~ AVG, hitter_points) 

w_model <- lm(w ~ W, pitcher_points) 
sv_model <- lm(sv ~ SV, pitcher_points) 
so_model <- lm(so ~ SO, pitcher_points) 
era_model <- lm(era ~ ERA, pitcher_points) 
whip_model <- lm(whip ~ WHIP, pitcher_points) 

hr_factor = hr_model$coefficients["HR"]
r_factor = r_model$coefficients["R"]
rbi_factor = rbi_model$coefficients["RBI"]
sb_factor = sb_model$coefficients["SB"]
avg_factor = avg_model$coefficients["AVG"]

melonheads_h <- pull(hitter_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(H))
melonheads_ab <- pull(hitter_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(AB))

w_factor = w_model$coefficients["W"]
sv_factor = sv_model$coefficients["SV"]
so_factor = so_model$coefficients["SO"]
era_factor = era_model$coefficients["ERA"]
whip_factor = whip_model$coefficients["WHIP"]

melonheads_ip <- pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(IP))
melonheads_er <- pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(ER))
melonheads_wh <- pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(BB)) + pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(H))

Build list of project draft value

#List of available players
hitter_projections %>% 
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  filter(is.na(billikenTeam)) %>% 
  mutate(AVG = round(AVG,3)) %>% 
  mutate(point_value = round(HR * hr_factor + R * r_factor + RBI * rbi_factor + SB * sb_factor + avg_factor * ((melonheads_h + H)/(melonheads_ab + AB) - melonheads_h/melonheads_ab),1)) %>%  
  select(Name, Team, PA, HR, R, RBI, SB, AVG, point_value) %>% 
  arrange(desc(point_value))

NA

hitter_projections <- hitter_projections %>% 
  mutate(point_value = round(HR * hr_factor + R * r_factor + RBI * rbi_factor + SB * sb_factor + avg_factor * ((melonheads_h + H)/(melonheads_ab + AB) - melonheads_h/melonheads_ab),1))

pitcher_projections <- pitcher_projections %>% 
  mutate(point_value = round(W * w_factor + SV * sv_factor + SO * so_factor + era_factor * (9*(melonheads_er + ER)/(melonheads_ip + IP) - 9*melonheads_er/melonheads_ip) + whip_factor * ((melonheads_wh + BB + H)/(melonheads_ip + IP) - melonheads_wh/melonheads_ip),1))

bind_rows(hitter_projections, pitcher_projections) %>% 
  #filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  filter(billikenTeam == "Melonheads") %>% 
  mutate(AVG = round(AVG,3), ERA = round(ERA,2), WHIP = round(WHIP,2)) %>%  
  select(Name, Team, PA, HR, R, RBI, SB, AVG, IP, W, SV, SO, ERA, WHIP, point_value) %>% 
  arrange(desc(point_value))

NA

All projected players with billiken league details

projected_players <- bind_rows(hitter_projections, pitcher_projections) %>% 
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  stringdist_left_join(positions, by = c("Name" = "player"), max_dist = 2) %>% 
  #stringdist_left_join(salaries, by = c("Name" = "Player"), max_dist = 2) %>% 
  #mutate(salary = case_when(!is.na(billikenTeam) ~ salary, TRUE ~ new_salary)) %>% 
  #filter(is.na(Owner) & !is.na(billikenTeam)) %>% 
  mutate(AVG = round(AVG,3), ERA = round(ERA,2), WHIP = round(WHIP,2), SO = case_when(IP == 0 ~ NA, IP > 0 ~ SO)) %>%  
  mutate(HR = case_when(PA == 0 ~ NA, PA > 0 ~ HR), R = case_when(PA == 0 ~ NA, PA > 0 ~ R), AVG = case_when(PA == 0 ~ NA, PA > 0 ~ AVG)) %>% 
  select(Name, billikenTeam, contract, salary, Team, PA, HR, R, RBI, SB, AVG, IP, W, SV, SO, ERA, WHIP, point_value, p_c, p_1b, p_2b, p_3b, p_ss, p_of, p_ci, p_mi, p_dh) %>% 
  arrange(desc(point_value)) #%>% 
  #filter(billikenTeam == "Melonheads") 

projected_players

NA

Replacement level example plot

pos <- projected_players %>% 
  filter(p_c == 1) %>% 
  mutate(rank_c = row_number(desc(point_value)))

ggplot(pos, aes(x=rank_c, y=point_value)) +
  geom_point() +
  geom_vline(xintercept = 21, color = "red")

Calculate replacement level by position (with no shared positions)

rl_c <- projected_players %>% 
  filter(p_c == 1) %>% 
  filter(row_number(desc(point_value)) == 21L) %>% 
  mutate(pos = 'c') %>% 
  select(Name, pos, point_value)

rl_1b <- projected_players %>% 
  filter(p_1b == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = '1b') %>% 
  select(Name, pos, point_value)

rl_2b <- projected_players %>% 
  filter(p_2b == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = '2b') %>% 
  select(Name, pos, point_value)

rl_3b <- projected_players %>% 
  filter(p_3b == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = '3b') %>% 
  select(Name, pos, point_value)

rl_ss <- projected_players %>% 
  filter(p_ss == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = 'ss') %>% 
  select(Name, pos, point_value)

rl_of <- projected_players %>% 
  filter(p_of == 1) %>% 
  filter(row_number(desc(point_value)) == 51L) %>% 
  mutate(pos = 'of') %>% 
  select(Name, pos, point_value)

rl_ci <- projected_players %>% 
  filter(p_ci == 1) %>% 
  filter(row_number(desc(point_value)) == 31L) %>% 
  mutate(pos = 'ci') %>% 
  select(Name, pos, point_value)

rl_mi <- projected_players %>% 
  filter(p_mi == 1) %>% 
  filter(row_number(desc(point_value)) == 31L) %>% 
  mutate(pos = 'mi') %>% 
  select(Name, pos, point_value)

rl_dh <- projected_players %>% 
  filter(p_dh == 1) %>% 
  filter(row_number(desc(point_value)) == 11L) %>% 
  mutate(pos = 'dh') %>% 
  select(Name, pos, point_value)

rl_util <- projected_players %>% 
  filter(row_number(desc(point_value)) == 151L) %>% 
  mutate(pos = 'util') %>% 
  select(Name, pos, point_value)

rl_p <- projected_players %>% 
  filter(IP > 0) %>% 
  filter(row_number(desc(point_value)) == 91L) %>% 
  mutate(pos = 'p') %>% 
  select(Name, pos, point_value)

(replacement_level <- rbind(rl_c, rl_1b, rl_2b, rl_3b, rl_ss, rl_of, rl_ci, rl_mi, rl_dh, rl_util, rl_p))

NA

Note - multiposition players not totally clean here.

Assume that we use the lowest replacement level of any position a player qualifies for.

Points Above Replacement

par <- projected_players %>% 
  mutate(repl = case_when(IP > 0 ~ 0.9, 
                          p_c == 1 ~ 0.4,
                          p_3b == 1 ~ 1.1,
                          p_of == 1 ~ 1.5,
                          p_ci == 1 ~ 1.5,
                          p_1b == 1 ~ 1.8,
                          .default = 2.1)
         ) %>% 
  mutate(par = point_value - repl) %>% 
  arrange(desc(par)) %>% 
  select(Name, Team, billikenTeam, contract, salary, point_value, repl, par, PA, HR, R, RBI, SB, AVG, IP, W, SV, SO, ERA, WHIP, p_c, p_1b, p_2b, p_3b, p_ss, p_of, p_ci, p_mi, p_dh)

par

ggplot(par, aes(par,salary)) +
  geom_point() +
  geom_smooth(method="lm")

ev_model <- lm(salary ~ par, par) 


#par$ev <- par$par*2.118+4.840
par$ev <- par$par*3.385+5.154

par$surplus <- round(par$ev - par$salary,1)
par$ev <- round(par$ev,1)

Projections by Billiken Team

Add in new salaries

Project/simulate draft - Project/simulate next draft pick

Factor in salaries and cap

Build form for draft picks with projected standings

ggplot(projected_draft_eligible, aes(x = pick, y = ev)) + 
  scale_x_continuous(breaks=seq(1, 101, 10)) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  xlim(0,100) +
  geom_smooth(formula = y ~ log(x)) +
  geom_point()

Scale for x is already present.
Adding another scale for x, which will replace the existing scale.